{
  Copyright 2012 Sergey Ostanin

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
}

unit SelectQuestionScreen;

interface

uses
  Classes, SysUtils, Windows, FileUtil, Forms, Controls, ExtCtrls, TestUiUtils,
  TestCore, SelectQuestion, MiscUtils, PadWidget, VisualUtils, StdCtrls, LCLType,
  LMessages, QuestionScreens;

type
  TSelectQuestionScreenFrame = class(TFrame, IQuestionScreen)
    pnlQuestion: TPanel;
    sbxQuestion: TScrollBox;
  private type
    TPanelList = TGenericObjectList<TPanel>;
  private
    FQuestion: TSelectQuestion;
    FFormulation: TPadWidget;
    FChoices: TPanelList;
    FReadOnly: Boolean;
    procedure MarkSelectedChoices;
    procedure ChoiceClick(Sender: TObject);
    procedure ToggleChoice(ChoiceIndex: Integer);
    procedure CheckBoxEnter(Sender: TObject);
  protected
    function ChildKey(var Message: TLMKey): Boolean; override;
    { private declarations }
  public
    destructor Destroy; override;
    procedure SetUp(Question: TQuestion);
    procedure GoReadOnly;
    function GetQuestion: TQuestion;
    { public declarations }
  end; 

implementation

{$R *.lfm}

const
  SELECTED_CHOICE_COLOR = $ffcc99;
  UNSELECTED_CHOICE_COLOR = $ffffff;

{ TSelectQuestionScreenFrame }

procedure TSelectQuestionScreenFrame.MarkSelectedChoices;
var
  i: Integer;
  p: TPanel;
  c: TCustomCheckBox;
  pw: TPadWidget;
begin
  for i := 0 to FQuestion.ChoiceCount-1 do
  begin
    p := FChoices[i];
    c := FindOwnedComponent(p, 'check') as TCustomCheckBox;
    pw := FindOwnedComponent(p, 'pad') as TPadWidget;

    if FQuestion.Response.IsSelected(i) then
    begin
      c.State := cbChecked;
      pw.Color := SELECTED_CHOICE_COLOR;
    end
    else
    begin
      c.State := cbUnchecked;
      pw.Color := UNSELECTED_CHOICE_COLOR;
    end;

    c.TabStop := FALSE;
  end;
end;

procedure TSelectQuestionScreenFrame.ChoiceClick(Sender: TObject);
begin
  ToggleChoice((Sender as TComponent).Tag);
end;

procedure TSelectQuestionScreenFrame.ToggleChoice(ChoiceIndex: Integer);
var
  AlreadySelected: Boolean;
begin
  AlreadySelected := FQuestion.SingleChoiceHint and FQuestion.Response.IsSelected(ChoiceIndex);
  if not FReadOnly and not AlreadySelected then
  begin
    if FQuestion.SingleChoiceHint then
      FQuestion.Response.DeselectAll;

    if FQuestion.Response.IsSelected(ChoiceIndex) then
      FQuestion.Response.Deselect(ChoiceIndex)
    else
      FQuestion.Response.Select(ChoiceIndex);

    MarkSelectedChoices;
  end;
end;

procedure TSelectQuestionScreenFrame.CheckBoxEnter(Sender: TObject);
begin
  SendMessage((Sender as TWinControl).Handle, WM_CHANGEUISTATE, MAKELONG(UIS_SET, UISF_HIDEFOCUS), 0);
end;

destructor TSelectQuestionScreenFrame.Destroy;
begin
  FreeAndNil(FFormulation);
  FreeAndNil(FChoices);
  FreeAndNil(FQuestion);
  inherited;
end;

procedure TSelectQuestionScreenFrame.SetUp(Question: TQuestion);
var
  i: Integer;
  p, cp: TPanel;
  c: TCustomCheckBox;
  pw: TPadWidget;
begin
  FQuestion := (Question as TSelectQuestion).Clone as TSelectQuestion;
  MakeVerticallyAutoScrollable(sbxQuestion);

  DisableAutoSizing;
  try
    FFormulation := TPadWidget.Create(nil);
    FFormulation.Border := TRUE;
    FFormulation.Parent := pnlQuestion;
    FFormulation.ReadOnly := TRUE;
    FFormulation.Model.Assign(FQuestion.Formulation);

    FChoices := TPanelList.Create;
    for i := 0 to FQuestion.ChoiceCount-1 do
    begin
      p := FChoices.AddSafely(TPanel.Create(nil));
      p.BevelOuter := bvNone;
      p.Parent := pnlQuestion;

      cp := TPanel.Create(p);
      cp.BevelOuter := bvNone;
      cp.Align := alLeft;
      cp.AutoSize := TRUE;
      cp.Parent := p;

      if FQuestion.SingleChoiceHint then
        c := TRadioButton.Create(p)
      else
        c := TCheckBox.Create(p);
      c.Name := 'check';
      c.Caption := '';
      c.Align := alTop;
      c.BorderSpacing.Right := 5;
      c.Parent := cp;
      c.Tag := i;
      c.OnClick := ChoiceClick;
      c.OnEnter := CheckBoxEnter;

      pw := TPadWidget.Create(p);
      pw.Name := 'pad';
      pw.Align := alClient;
      pw.BorderSpacing.Top := 2;
      pw.Parent := p;
      pw.ReadOnly := TRUE;
      pw.Model.Assign(FQuestion.Choices[i].Pad);
      pw.Tag := i;
      pw.Cursor := crHandPoint;
      pw.OnClick := ChoiceClick;
    end;
  finally
    EnableAutoSizing;
  end;

  MarkSelectedChoices;
end;

procedure TSelectQuestionScreenFrame.GoReadOnly;
var
  p: TPanel;
begin
  FReadOnly := TRUE;
  for p in FChoices do
  begin
    (FindOwnedComponent(p, 'check') as TCustomCheckBox).Enabled := FALSE;
    (FindOwnedComponent(p, 'pad') as TPadWidget).Cursor := crDefault;
  end;
end;

function TSelectQuestionScreenFrame.GetQuestion: TQuestion;
begin
  Result := FQuestion;
end;

function TSelectQuestionScreenFrame.ChildKey(var Message: TLMKey): Boolean;
var
  n: Integer;
begin
  if not FReadOnly and (Message.CharCode in [VK_1..VK_9]) then
  begin
    Result := TRUE;
    n := Message.CharCode - VK_1;
    if n < FQuestion.ChoiceCount then
    begin
      ToggleChoice(n);
      ScrollControlIntoView(FChoices[n]);
    end;
  end
  else
    Result := inherited;
end;

initialization

  QuestionScreenRegistry.Add(TSelectQuestionScreenFrame, TSelectQuestion);

end.

